;DIRECT.MAC;9 18-Mar-81 17:53:34, Edit by MMCM ; SUMEX GTJFN additions ;DSK:DIRECT.MAC;6 17-Jul-80 17:28:41, Edit by FRENCH ;ALLOW REDUNDANT LOCKING OF DIRECTORIES ;<134-TENEX>DIRECT.MAC;5 16-Feb-80 18:05:15 EDIT BY PETERS ; Install ISI bug fixes ;<134-TENEX>DIRECT.MAC;4 29-Jun-77 20:20:45 TVEDIT'd by Geoff ; SETDIR - Smashed directory is a BUGHLT for heavens sake! ;<134-TENEX>DIRECT.MAC;3 13-MAY-76 17:08:01 EDIT BY UNTULIS ;DISABLE PASSING ON OF PERPETUAL STATUS ;<134-TENEX>DIRECT.MAC;103 28-AUG-75 16:45:44 EDIT BY ALLEN ; MODS TO CORRESPOND TO NEW LOCK-UNLOCK MACROS ;<134-TENEX>DIRECT.MAC;102 20-JUN-75 07:46:49 EDIT BY TOMLINSON ; DON'T PROPOGATE FDBUND ;<134-TENEX>DIRECT.MAC;101 28-APR-75 15:04:17 EDIT BY CLEMENTS ;<134-TENEX>DIRECT.MAC;100 28-APR-75 12:13:35 EDIT BY CLEMENTS ;<134-TENEX>DIRECT.MAC;99 28-APR-75 11:31:46 EDIT BY CLEMENTS ;<134-TENEX>DIRECT.MAC;98 24-APR-75 14:14:44 EDIT BY CLEMENTS ;<134-TENEX>DIRECT.MAC;97 16-APR-75 13:20:01 EDIT BY TOMLINSON ; INIBLK: CALL SETHIQ BEFORE CLEARING DIRLCK ;<133-TENEX>DIRECT.MAC;96 5-SEP-74 15:29:13 EDIT BY ALLEN ; CHANGE SETOM DIRLCK TO UNLOCK DIRLCK ;DIRECT.MAC;95 3-JUN-74 16:07:12 EDIT BY TOMLINSON ; CHECK FOR ILLEGAL NEG VERSION NUMBERS ;DIRECT.MAC;94 12-APR-74 14:09:59 EDIT BY TOMLINSON ; FIXED BUG IN IMPLICITLY UNDELETED PRM FILE LOGIC ;DIRECT.MAC;93 25-MAR-74 10:45:43 EDIT BY TOMLINSON ; UNDELETED PERMANENT FILES ARE CONSIDERED OLD VERSIONS. FDBSIZ_0 ;DIRECT.MAC;91 19-MAR-74 11:03:04 EDIT BY TOMLINSON ; BUG FIXES IN NEW MAPDIR ;DIRECT.MAC;90 18-MAR-74 21:44:28 EDIT BY TOMLINSON ;DIRECT.MAC;89 18-MAR-74 19:40:52 EDIT BY TOMLINSON ; NEW MAPDIR FOR OLD AND NEW FORMAT FD'S ;DIRECT.MAC;1 4-MAR-74 15:18:59 EDIT BY BTHOMAS ;DIRECT.MAC;88 30-NOV-73 16:50:07 EDIT BY TOMLINSON ;DIRECT.MAC;87 27-NOV-73 17:46:25 EDIT BY CLEMENTS ;DIRECT.MAC;86 9-NOV-73 19:33:19 EDIT BY CLEMENTS ;DIRECT.MAC;85 2-NOV-73 11:28:17 EDIT BY TOMLINSON ; FIX TO XPAND0 TO LIMIT SIZE OF SUBINDEX TO 8 PAGES ;DIRECT.MAC;84 9-APR-73 16:05:06 EDIT BY TOMLINSON ; PROTECTED PROTECTION CHANGES FROM NON-OWNERS ;DIRECT.MAC;83 21-NOV-72 1:12:22 EDIT BY TOMLINSON ;DIRECT.MAC;82 31-OCT-72 22:53:05 EDIT BY TOMLINSON ; TEMPORARY PATCH TO MAPDIR FOR COMPATIBILITY WITH NEW CODE ;DIRECT.MAC;81 31-OCT-72 9:09:27 EDIT BY TOMLINSON ; REMOVE CALL'S ;DIRECT.MAC;80 30-OCT-72 15:10:16 EDIT BY TOMLINSON ;DIRECT.MAC;79 30-OCT-72 13:24:12 EDIT BY TOMLINSON ;DIRECT.MAC;79 30-OCT-72 13:12:58 EDIT BY TOMLINSON ; DIRETORY PROTECTION ;DIRECT.MAC;78 30-OCT-72 11:48:06 EDIT BY TOMLINSON ; FDBPRM NOT PROPOGATED TO NEW VERSIONS SEARCH PROLOG,STENEX TITLE DIRECT SUBTTL R.S.Tomlinson EXTERN FDFMTF,SYSIFG EXTERN ASGDFR,FORKX,GCDIR,GETFDB,JOBDIR,MODES,RELDFR EXTERN FKGRPS,FKDIR,WCCMP EXTERN BUGCHK,BUGHLT,CAPENB,DIOFN,FDOFN,FILDNW,FILEXW EXTERN MRMAP,MRPACS,SETMPG IFN USRMOD,< EXTERN MAPDIR > IFE USRMOD, ; Check protection of file/directory ; Call: LH(A) ; Readf, wrtf etc. bits in left half ; RH(A) ; Location of fdb if call to accchk ; PUSHJ P,DIRCHK ; To check access to a directory ; Or ; PUSHJ P,ACCCHK ; To check access to a file ; Return ; +1 ; Error, access not allowed ; +2 ; Ok ; The directory in which the protection is checked must be locked ; If LH(A) = -1 and ; If NAMSF = TRUE in LH of F1, ; Require PT access bit at least for GTJFN ; If NAMSF = FALSE, ; If DIRNUM = Login or Connected, then ; Always allow GTJFN (specific name always passes for SELF) ; ELSE ; Allow access if ANY access bit is on in the appropriate ; group/other field DIRCHK::SKIPA B,DIRPRT ACCCHK::MOVE B,FDBPRT(A) ; Get protection of this file MOVE C,CAPENB TRNE C,WHEEL!OPR JRST SKPRET push p,d ; Save ac's push p,e move e,forkx ; e _ this fork number skipge d,fkdir(e) ; Top fork in group? move d,fkdir(d) ; No, d _ conn dir,,log dir hrrz c,d ; c _ log dir CAMN C,DIRNUM ;REFERENCE TO OWN DIR? JRST ACCCH0 ; Yes hlrz c,d ; c _ conn dir camn c,dirnum ; Reference to connected dir? JRST ACCCH0 ; Yes move c,fkgrps(e) ; c _ group membership of top fork in group skipge e,fkdir(e) move c,fkgrps(e) pop p,e ; Restore ac's pop p,d TDNN C,DIRGRP ; Have group access? LSH B,6 ; No, have to use other LSH B,6 TLC A,-1 ; Now LH(A) = -1 case? TLCE A,-1 JRST ACCCH9 ; No, do it as usual TEST(NE,NAMSF) ; Yes, wild card name? JRST ACCCH1 ; Yes, require PT access TRNN B,770000 ; No, accept any bits at all POPJ P, ; Tough, no access JRST SKPRET ; OK, let him have it ACCCH0: pop p,e ; Restore ac's pop p,d TLC A,-1 ; Login or Conn dir here, LH(A) = -1? TLCE A,-1 JRST ACCCH9 ; No, do usual test TEST(NN,NAMSF) ; Yes, is name wild? JRST SKPRET ; No, always let him have it ACCCH1: HRLI A,ASPF ; Set PT access required (not used in ; dir) and do usual check ACCCH9: ANDCAI B,770000 ; Mask off 6 bits and complement LSH B,^D18-1 AND A,B ; Get bad bits JFFO A,ACCCH2 ; If any ones, access not permitted JRST SKPRET ACCCH2: SOS B,A+1 ; Get bit number ROT B,-1 ; Divide by 2 HRRZ A,ACCERT(B) ; Get error number SKIPL B HLRZ A,ACCERT(B) POPJ P, ACCERT: XWD OPNX3,OPNX4 XWD OPNX5,OPNX6 XWD OPNX12,OPNX13 ; Directory lookup ; Call: A ; Iowd # full words in input, loc first word ; FILOPT(JFN) ; Location of last byte if recognition ; PUSHJ P,DIRLUK ; For recognition ; Or ; PUSHJ P,DIRLKX ; For no recognition ; Return ; +1 ERROR, NO MATCH ; +2 ERROR, AMBIGUOUS ; +3 OK, IN A, THE DIRECTORY NUMBER ; Clobbers a,b,c,d, filopt(jfn) and bits mtchf, ambgf, norec1 DIRLUU::TEST(O,UNLKF) TEST(O,NREC1) JRST DIRLU0 DIRLUK:: TEST(ZA,NREC1) DIRLKX:: TEST(O,NREC1) TEST(Z,UNLKF) DIRLU0: TEST(Z,MTCHF,AMBGF) PUSH P,A ; Save input pointer MOVEI A,0 PUSHJ P,SETDIR ; Map block 0 of directory index JRST [ POP P,A ; Does not exist. if this happens, ; The index is screwed up POPJ P,] ; Proceed as for failure IFN 0,< SKIPE A,LSTDNO ; Copy LSTDNO to GETTAB MOVEM A,TOPDIR## ; for programs like DELD to quit early > MOVE A,(P) ; Get the input pointer MOVE B,1(A) ; Get the first word of the input string LSH B,-^D29 ; Shift over to the first character IDIVI B,5 ; Prepare to dispatch to proper subindex LDB A,DPTAB(B+1) JUMPE A,[POP P,A ; There is no subindex for this char PUSHJ P,USTDIR POPJ P,] ; Fail MOVNS A ; Convert to negative subindex number PUSHJ P,USTDIR PUSHJ P,SETDIR ; And map the correct subindex JRST [POP P,A ; Subindex does not exist ; Indicates fouled up directory index POPJ P,] ; Treat as failure POP P,A ; Restore input pointer MOVEI B,0 PUSHJ P,LOOKUP JRST DIRFND DIRLK9: HRRZ A,DIRLOC ; Get directory number rh(symtabptr) HRRZ A,DIRORG(A) TEST(NE,UNLKF) ; If entry at dirluu, JRST SKPRET ; Return skipping with directory locked PUSHJ P,USTDIR JRST SK2RET ; Double skip return DIRFND: TEST(NE,MTCHF) TEST(NE,NREC,NREC1) ; No exact match, recognize? JRST DIRFD2 ; No pushj p,updstr ; Yes, update the string hlrz b,dirloc ; Unique match? jumpe b,dirlk9 ; If 0, yes. jrst ambret ; Otherwise, give an ambiguous return DIRFD2: TEST(NN,UNLKF) ; If entry not at dirluu, JRST ERRET ; Return unlocking directory POPJ P, ; Otherwise, return no skip ; Here we update a string to recognize as much as possible. ; Entry: DIRINP = pointer to input string ; DIRLOC = LH - # of chars matching + 1 (0 if all) ; RH - adr of sym tab entry for string ; Call: PUSHJ P,UPDSTR ; Return: +1 always, FILOPT/FILCNT updated updstr: move b,dirloc ; Get rel location of string block hlrz c,dirorg(b) ; (sym tab or FDB ext) updstf: move a,dirinp ; And input pointer movni a,(a) ; Negative of origin of input add a,filopt(jfn) ; Get end of input relative to beginning addi a,dirorg+1(c) ; Yields pointer to tail of string hlrz b,dirloc ; Get # chars agreeing jumpe b,[hrrz b,dirorg(c) ; If none, use the block length subi b,1 imuli b,5 jrst .+2] subi b,1 ; Account for extra count if substring jumple b,cpopj ; If still non-positive, quit updstc: ildb c,a ; Copy tail to input jumpe c,updste ; Quit if encountered null sosge filcnt(jfn) ; Update buffer char count jrst updste ; If overflow, quit idpb c,filopt(jfn) sojg b,updstc ; Do up to maximum count updste: movei c,0 ; Tag on a trailing null move b,filopt(jfn) idpb c,b popj p, ; Pointers to subindex dispatch table RADIX ^D10 Q==6 DPTAB: REPEAT 5,< POINT 7,SBIDTB(B),Q Q==Q+7> RADIX 8 ; Directory number to string conversion ; Call: A ; The directory number ; PUSHJ P,GDIRST ; Return ; +1 ; Error, no such directory number ; +2 ; Ok, in a, pointer to string block holding the name ; The directory index is locked upon exit, and must be unlocked ; After the string is used ; Clobbers a,b,c,d GDIRST::PUSHJ P,GETDDB ; Get the ddb POPJ P, ; None HRRZ A,DDBNAM(A) ; Get pointer to name ADDI A,DIRORG ; As absolute address JRST SKPRET ; Initilize a directory block ; Call: A ; Most common block size in the directory ; B ; INITIAL SIZE OF DIRECTORY ; C ; DIRECTORY NUMBER ; ; At dirorg, the directory in question ; PUSHJ P,INIBLK IFE USRMOD, INIBLK::PUSH P,A MOVE A,[XWD DIRORG,DIRORG+1] SETZM DIRORG BLT A,DIRORG-1(B) ; Clear all of directory POP P,DIRFRE+3 MOVEM C,DIRNUM CALL SETHIQ SETZM DIRLCK ; Initially locked MOVE A,[XWD 500000,777752] MOVEM A,DIRDPW ; Default protection is all access MOVE A,[XWD 500000,777740] MOVEM A,DIRPRT ; Directory protection is all access MOVEI A,2 MOVEM A,DIRDBK MOVEM B,SYMBOT ; Null symbol table MOVEM B,SYMTOP MOVEI A,DIFREE-DIRORG HRLOM A,DIRFRE HRRM A,DIRFRE+4 SUB A,B ; Negative of space to a ASH A,-6 ; Reserve 1/64 of space for symtab ADD A,B ; Remainder for dynamic storage MOVEM A,FRETOP HRLM A,DIRFRE+4 SUBI A,DIFREE-DIRORG MOVEM A,DIFREE MOVEM A,DIRFRE+2 SETOM DIRFRE+1 SETOM DIREXL ;unlock expunge lock !!MAH@SUMEX 11/6/74!! POPJ P, IFE USRMOD, ; Get directory descriptor block location ; Call: A ; Directory number ; PUSHJ P,GETDDB ; Return ; +1 ; No such directory ; +2 ; Ok, a addresses the directory descriptor block ; Leaves the directory subindex locked and psi off ; Clobbers a,b,c,d GETDDB::PUSHJ P,HSHLUK ; Look up number in hash table JRST [ PUSHJ P,USTDIR POPJ P,] ; Not found GETDD0: PUSHJ P,USTDIR ; Release block 0 HLRZ A,C ; Location of the descriptor block IDIVI A,10000 ; Separate subindex number and offset PUSH P,A+1 ; Save offset MOVNS A PUSHJ P,SETDIR ; Map the pertinent subindex JRST [ POP P,A POPJ P,] POP P,A ADDI A,DIRORG JRST SKPRET ; Skip return ; Hash table lookup routine ; Call: A ; Directory number ; PUSHJ P,HSHLUK ; Return ; +1 ; Error, no such number ; +2 ; Success ; LH(C) ; Location of ddb ; B ; Location of hash table entry HSHLUK::PUSH P,A ; Save directory number MOVEI A,0 PUSHJ P,SETDIR ; Map block 0 of the directory subindex BUG(HLT,) POP P,A MOVE B,A IMULI B,741633 ; Hash on the directory number ROT B,7 TSC B,B LSH B,-1 MUL B,DIRHTL ADD B,DIRHTO ; Initial location to probe PUSH P,B PUSH P,[0] GETDD1: MOVE C,DIRORG(B) ; Get the hash table entry JUMPLE C,[CAMG C,[XWD -2,0] JRST HSHLU1 ; Place-holder SKIPN (P) ; Position found yet? MOVEM B,(P) ; No, save this pointer JUMPL C,HSHLU1 POP P,B ; Lookup failure SUB P,[XWD 1,1] POPJ P,] ; Return CAIN A,(C) ; Compare rh to input number JRST [ SUB P,[XWD 2,2] JRST SKPRET] HSHLU1: SOS B ; Cycle backward through table CAMGE B,DIRHTO ADD B,DIRHTL CAME B,-1(P) JRST GETDD1 POP P,B SUB P,[XWD 1,1] POPJ P, ; Insert account string/number in fdb ; Call: A ; Location of fdb ; FILACT(JFN) ; Negative number or positive string location ; PUSHJ P,INSACT ; Returns +1 always ; Clobbers b,c INSACT::PUSHJ P,GETFDB POPJ P, PUSH P,A ; Save the FDB index MOVSI A,XCTF ; Must have owner rights to insert acct PUSHJ P,DIRCHK JRST [POP P,A ; No dice JRST ERRET] POP P,A PUSHJ P,INSAC0 JRST ERRET INSAC0: PUSH P,A SKIPG B,FILACT(JFN) ; Number? JRST CPYACG CPYACT: HRRO A,CAPENB TRNN A,WHEEL!OPR MOVE A,MODES TLNN A,(1B1) JRST CPYACF MOVN A,(B) HRLZI A,2(A) HRR A,B MOVEI B,100000 PUSHJ P,LOOKUP JRST CPYAC1 MOVE B,DIRLOC HLRZ B,DIRORG(B) CPYAC0: AOS DIRORG+1(B) ; Increment share count CPYACG: POP P,A ; Restore fdb pointer MOVEM B,FDBACT(A) ; Store as account POPJ P, CPYACF: MOVE B,[500000,,INIACT] ; USE OVERHEAD ACCOUNT JRST CPYACG CPYAC1: MOVE A,SYMBOT SUBI A,2 CAMG A,FRETOP ; Room for new symtab entry? JRST [ PUSHJ P,XPAND ; No, try to expand symtab JRST CPYACF ; Can't. JRST .+1] HLRE A,DIRINP MOVN B,A ADDI B,3 PUSH P,B PUSHJ P,ASGDFR JRST [ POP P,B JRST CPYACF] HRLZ B,DIRINP HRRI B,2(A) POP P,D ADDI D,-3(B) BLT B,(D) MOVE C,DIRMSK ANDM C,(D) SETZM 1(A) MOVEI B,-DIRORG(A) HRLZ C,B HRRI C,100000 SOS B,DIRLOC SOS A,SYMBOT ADDI A,DIRORG HRLI A,1(A) CAIL B,-DIRORG+1(A) BLT A,DIRORG-1(B) MOVEM C,DIRORG(B) HLRZ B,C JRST CPYAC0 ; Insert protection into fdb ; Call: FILPTR(JFN) ; Protection number ; A ; Location of fdb ; PUSHJ P,INSPRT ; Returns +1 ; Clobbers b INSPRT::PUSHJ P,GETFDB POPJ P, PUSH P,A MOVSI A,XCTF ; Check for owner privilege PUSHJ P,DIRCHK JRST [ POP P,A JRST ERRET] POP P,A MOVE B,FILPRT(JFN) MOVEM B,FDBPRT(A) JRST ERRET ; Initialize fdb ; Call: A ; Location of fdb ; PUSHJ P,FDBINI ; Return +1 always ; Initializes the fdb as follows: ; FDBCTL ; Fdbnxf (non-existent) ; FDBCRE ; Date and time of now ; FDBCRV ; Date and time of now ; All else is zeroed including fdbext, fdbver, etc. ; Clobbers b,c,d ; Preserves a FDBINI: MOVEI B,400100 HRLM B,(A) ; Mark the block as fdb type HRLZI B,1(A) HRRI B,2(A) SETZM 1(A) BLT B,FDBLEN-1(A) ; Clear the entire fdb PUSH P,A GTAD ; Get today POP P,B MOVEM A,FDBCRE(B) ; Set creation dates MOVEM A,FDBCRV(B) MOVSI A,FDBNXF MOVEM A,FDBCTL(B) MOVE A,DIRDPW MOVEM A,FDBPRT(B) MOVSI A,500000 MOVEM A,FDBACT(B) ; Set account to 0 for now IFN 0,< MOVE A,DIRDBK ;Get defult version to keep DPB A,[POINT 6,FDBBYV(B),5] ;Get number to keep > MOVE A,B POPJ P, ; Set directory or directory index ; Call: A ; Directory number or subindex number ; B ; Ofn of the appropriate directory unless its the di ; PUSHJ P,SETDIR ; For mapping a directory ; Or ; PUSHJ P,SETDIR ; For mapping a directory subindex ; Return ; +1 ; Non-existent directory ; +2 ; Normal, the 10 pages starting at dirorg are set up ; Clobbers a,b,c,d IFE USRMOD, SETDIR::NOINT PUSH P,A PUSH P,B MOVEI A,DIRORG PUSHJ P,MRMAP ; Read the ident of current directory JRST SETDI5 PUSH P,A HLRZS A PUSHJ P,CVOFNU ; Convert ofn to logical unit CAME A,-1(P) ; Compare to required logical unit JRST [ SUB P,[XWD 1,1] POP P,B MOVE A,0(P) JRST SETDI1] POP P,A PUSHJ P,MRPACS ; Read access of page MOVE C,A POP P,B MOVE A,0(P) ;DIRECTORY NUMBER TLNE C,(1B5) ; If non-existent CAME A,DIRNUM ; Or different SETDI1: PUSHJ P,MAPDIR ; Must map it first MOVEI A,DIRORG PUSHJ P,MRMAP BUG(HLT,) PUSHJ P,MRPACS MOVE C,A POP P,A ;DIRECTORY NUMBER TLNE C,(1B5) ;IF STILL NO ACCESS, CAME A,DIRNUM ;OR NUMBER DOESN'T COMPARE, JRST SETDI4 SKIPGE DIRLCK ;LOCKED? JRST SETDIL ;NO-CAN'T BE CHKDSK TRYING TO LOCK AGAIN HRRZ 2,DIRUSE ;FORKX OF LOCKER CAME 2,FORKX ;IS IT OUR LOCK? JRST SETDIL ;NO-SOMEBODY ELSE HAS IT MOVSI 2,1 ;LH BUMPER ADDM 2,DIRUSE ;TO INDICATE WE LOCKED IT AGAIN JRST SKPRET ;AND GIVE SUCCESS SETDIL: LOCK DIRLCK,,HIQ PUSH P,FORKX POP P,DIRUSE HRRZS DIRUSE ;MAKE SURE REDUNDANT COUNT IN LH IS CLEAR JRST SKPRET SETDI4: OKINT ; Directory non-existent BUG(HLT,) POPJ P, ; Give no-skip return SETDI5: SKIPE A ; Non-existent page? BUG(HLT,) POP P,B ; Yes, skip the following MOVE A,0(P) JRST SETDI1 ; Temporary cvofnu CVOFNU: MOVEI A,-1 POPJ P, ; Unlock directory USTDIR::PUSH P,1 HLRZ 1,DIRUSE ;GET REDUNDANT LOCK COUNT SOJL 1,USTDI1 ;IF COUNTED OUT, UNLOCK IT HRLM 1,DIRUSE ;STILL LOCKED-DEC THE REDUNDANT COUNT JRST USTDI2 USTDI1: UNLOCK DIRLCK,,HIQ USTDI2: POP P,1 OKINT POPJ P, ife usrmod,< MAPDIR::PUSH P,C ; SAVE AN ACCUMULATOR JUMPLE A,MAPDI6 ; SUBINDEX MOVNI B,1 ; TEMPORARY ; HRRES B CAML B,[-1] CAIL B,NDSKS-1 JRST MAPDI5 MAPDI4: MOVE B,PFDOFN+1(B) ; Get location of ofn's for this unit PUSH P,B ; Save CAIL A,NFDIB*100/2 BUG(HLT,) MOVEI C,20 ; DEFAULT NUMBER OF PAGES/DIRECTORY SECTION SKIPE FDFMTF ; OLD FORMAT? MOVEI C,10 ; YES, THEN 10 PAGES PER SECTION IMUL A,C ; COMPUTE PAGE OFFSET OF 0TH PAGE IDIVI A,1000 ; SEPARATE INTO PT/PAGE ADDB A,0(P) ; Location of ofn EXCH A,B HRL A,(B) ; Get ofn of pt PUSHJ P,MAPDI1 ; Map first half POP P,B SKIPN FDFMTF JRST MAPDI7 ; NEW STYLE -- DONE MOVEI A,-10(A) ; BACK UP PAGE NUMBER HRL A,NFDIB/2(B) ; GET SECOND HALF OFN MOVEI C,10 PUSHJ P,MAPDI2 ; Map second half MAPDI7: POP P,C ; RESTORE C POPJ P, MAPDI5: BUG(CHK,) MOVNI B,1 JRST MAPDI4 MAPDI6: LSH A,3 MOVEI C,10 MOVMS A HRL A,DIOFN CALL MAPDI1 JRST MAPDI7 MAPDI2: SKIPA B,[140000,,DIRORG+10000] MAPDI1: MOVE B,[140000,,DIRORG] MAPDIL: CALL SETMPG ADDI B,1000 AOS A SOJG C,MAPDIL POPJ P, > ;end usrmod conditional Q==0 PFDOFN: REPEAT NDSKS,< FDOFN+NFDIB*Q Q==Q+1> ife usrmod,< USE SWAPPC > ; Multiple directory device directory lookup routine ; Call: A ; Directory number ; PUSHJ P,MDDDIR ; Returns ; +1 ; Not used here, means non-directory device ; +2 ; No such directory ; +3 ; Ok, the directory is mapped and locked MDDDIR::AOS (P) ; Always skips atleast once TEST(NE,STEPF) TEST(NN,DIRSF) JRST SETDRR ; MAP AND CHECK DIRECTORY FOR READING PUSH P,B MDDDI4: PUSH P,A MDDDI5: MOVEI A,0 PUSH P,A ; Make a slot for the best sym tab entry PUSHJ P,SETDIR ; Map the index block 0 BUG(HLT,) MOVEI A,777777 ; Larger than any possible dir number AOS -1(P) ; Looking for one greater than last MOVE B,DIRHTO ADD B,DIRHTL SOS B MDDDI0: MOVE C,DIRORG(B) ; Get hash table entry PUSH P,C ; Save the whole entry for now JUMPLE C,MDDDI1 ; Empty slot HRRZS C ; Extract directory number CAMN C,-2(P) ; Is this what we are looking for JRST [POP P,-1(P) ; Yes, restore the hash entry JRST MDDDI2] ; And, map it etc. CAMLE C,-2(P) CAML C,A JRST MDDDI1 MOVE A,C ; Better than any other POP P,-1(P) ; Update current best sym tab ptr too SKIPA MDDDI1: SUB P,[1,,1] ; Reset the stack CAMLE B,DIRHTO SOJA B,MDDDI0 ; Loop through entire hash table CAIE A,777777 ; Were any found? JRST MDDDI3 ; Yes SUB P,[1,,1] ; Won't need sym tab ptr any more POP P,A POP P,B PUSHJ P,USTDIR POPJ P, MDDDI3: MOVEM A,-1(P) MDDDI2: POP P,C ; Recover best sym tab ptr HLRZ B,FILDNW(JFN) ; Any wild card specifier? JUMPE B,MDDDI6 ; If not don't check name LDB B,[POINT 14,1(B),13] ; Get the first two bytes CAIN B,<<"*">B28> ; Just regular star? JRST MDDDI6 ; Yes, assume match OK PUSHJ P,GETDD0 ; Must check, get DDB JRST MDDDI5 ; Failure, go try another HRRZ B,DDBNAM(A) ; Find the directory name ADDI B,DIRORG ADD B,[440700,,1] ; Make it a string ptr HLRZ A,FILDNW(JFN) ; Now get the wild card string if any ADD A,[440700,,1] ; Also a string ptr PUSHJ P,WCCMP ; See if it's OK JRST [PUSHJ P,USTDIR ; No go, release the directory JRST MDDDI5] ; And try another higher MDDDI6: PUSHJ P,USTDIR ; Name matches, release the DDB MOVE A,0(P) MOVE B,-1(P) PUSHJ P,SETDRR ; SEE IF WE CAN READ THIS JRST MDDDI5 ; CAN'T, TRY NEXT ONE POP P,A POP P,B JRST SKPRET SETDRR: PUSHJ P,SETDIR JRST [ MOVEI A,GJFX36 POPJ P,] PUSH P,A MOVSI A,READF PUSHJ P,DIRCHK JRST [ PUSHJ P,USTDIR SUB P,[1,,1] MOVEI A,GJFX35 POPJ P,] POP P,A JRST SKPRET ; Multiple directory device name lookup routine ; Call: A ; Lookup pointer ; DIRORG- ; The correct subdirectory, locked and psi off ; JRST MDDNAM ; Return ; +1 ; Match is impossible ; +2 ; Ambiguous ; +3 ; Success, if nrec&nrec1 are 0, the remainder if any ; ; Is appended to the string addressed by filopt(jfn) MDDNAM::JUMPE A,MDDSTP MOVEI B,0 PUSHJ P,LOOKUP JRST NAMFND TEST(NE,STEPF) TEST(NN,NAMSF) JRST NAMLK9 AOS B,DIRLOC ; Location in symtab of next after match MDDSN1: MOVEI C,700000 ; Prepare to test entry type CAMGE B,SYMTOP ; If above top TDNE C,DIRORG(B) ; Or not name JRST [ MOVEI A,GJFX18 ; Then fail JRST ERRET] ; None left HLRZ C,DIRORG(B) ; Pointer to name string MOVEI A,DIRORG+1(C) HRLI A,() HRRZ B,FILDNW(JFN) ; Get wild card string if any JUMPE B,UNIQLC ; If none, just carry on ADD B,[440700,,1] ; Got one, make it a pointer PUSH P,A ; Save ptr to current name EXCH A,B ; Set up as input and library PUSHJ P,WCCMP ; Do they match? JRST [SUB P,[1,,1] ; No, no need for this name AOS B,DIRLOC ; Point to next name JRST MDDSN1] ; And go see if it is real POP P,A ; Good match, take it JRST UNIQLC ; Copy new name to filopt NAMLK9: MOVE B,DIRLOC ADDI B,DIRORG HRRZ A,(B) ANDCMI A,700000 ; Mask off entry type bits ADDI A,DIRORG ; Convert to absolute address NAMLKM: TEST(NE,UNLKF) JRST SK2RET ; Do not unlock directory PUSHJ P,USTDIR JRST SK2RET IFE USRMOD, SK3RET::AOS (P) SK2RET::AOS (P) SKPRET::AOS (P) CPOPJ:: POPJ P, IFE USRMOD, MDDSTP: MOVE B,SYMBOT ; Get bottom of symbol table MOVEM B,DIRLOC JRST MDDSN1 NAMFND: TEST(NE,NREC,NREC1) ; Is recognition being performed JRST NEWNAM ; No. try to insert a new name MOVEI A,GJFX18 TEST(NN,MTCHF) ; Yes, did at least one string match? JRST ERRET ; Error return, no match possible pushj p,updstr ; Some match, update string hlrz b,dirloc ; Get number of chars matching jumpe b,namlk9 ; If unique, give success return movei a,gjfx18 jrst ambret ; Otherwise, ambiguous IFE USRMOD, AMBRET: TEST(NN,UNLKF) ; Ambiguity is downright failure if unlkf AOS (P) ERRET: PUSHJ P,USTDIR POPJ P, IFE USRMOD, uniqlc: movei b,-1 ; Infinite count pushj p,updstc ; Copy string jrst namlk9 ; And wrap it up NEWNAM: MOVE A,DIRINP TLNN A,-1 SKIPE DIRMSK JRST .+3 MOVEI A,GJFX33 JRST ERRET ; Null names not allowed MOVEI A,GJFX24 TEST(NE,OLDNF) ; Are new names ok? JRST ERRET ; No new names, error return MOVSI A,RNDF PUSHJ P,DIRCHK ; Does this user have append access JRST [ MOVEI A,GJFX24 JRST ERRET] MOVE A,SYMBOT SUBI A,2 CAMG A,FRETOP ; Room to expand symtab? JRST [ PUSHJ P,XPAND ; No, attempt to expand it JRST [ MOVEI A,GJFX23 JRST ERRET]; No room JRST .+1] TEST(O,NEWF) ; Remember we entered a new file name MOVEI B,FDBLEN PUSHJ P,ASGDFR ; Assign space for fdb JRST [ MOVEI A,GJFX23 JRST ERRET] PUSHJ P,FDBINI ; Initialize fdb MOVSI B,FDBNEX!FDBNXF IORM B,1(A) ; Set "no extension" flag in fdb MOVEM A,DIRSAV ; Save loc of fdb PUSHJ P,CPYDIR ; Copy the input string into directory JRST [ MOVE B,DIRSAV SETZM DIRSAV PUSHJ P,RELDFR MOVEI A,GJFX23 JRST ERRET] MOVEI C,400001 HRLM C,(A) ; Mark as string block for name MOVE C,DIRSAV ; Get fdb location SETZM DIRSAV SUBI A,DIRORG HRRM A,FDBCTL(C) ; Store location of name string in fdb SUBI C,DIRORG ; Relative to directory origin HRL C,A ; Put string block loc in lh SOS B,DIRLOC ; Restore sym tab location SOS A,SYMBOT ; Move bottom of symbol table down ADDI A,DIRORG HRLI A,1(A) CAIL B,-DIRORG+1(A) BLT A,DIRORG-1(B) ; Blt lower part of symtab down MOVEM C,DIRORG(B) ; Insert symtab pointer in symtab JRST NAMLK9 ; Multiple directory device extension lookup ; Call: A ; Lookup pointer ; B ; Pointer to start pointer (as left by mddnam) ; JRST MDDEXT ; Return ; +1 ; No match ; +2 ; Ambiguous ; +3 ; Ok, the remaining string is appended to filopt(jfn) MDDEXT::JUMPE A,MDDSTE ; Set to first extension HRRZM B,DIRSCN ; Save loc of pointer PUSHJ P,SETMSK ; Set up mask etc MOVE A,DIRSCN ; Save location of pointer MOVEM A,DIRLOC HRRZ A,@DIRSCN ; Get loc of first fdb ADDI A,DIRORG ; As absolute address MOVE B,FDBCTL(A) ; Get flags TLNE B,FDBNEX ; Is this fdb simply holding a place ; Because no extension is known? JRST NEWEXT ; Yes, then fill in extension MOVEI B,FDBEXT(A) ; Save next DIRSCN ptr PUSH P,B ; So we can handle NULL ext's properly EXTLK1: HLRZ B,FDBEXT(A) ; Get pointer to extension block ADDI B,DIRORG+1 ; As absolute address MOVN C,-1(B) ; Get length of block HRLI B,2(C) ; Account for header and partial word MOVE A,DIRINP ; Get pointer to input MOVE C,DIRMSK ; And mask PUSHJ P,STRCMP ; Compare strings JRST EXTNEQ ; Not equal JRST EXTNEQ ; Not equal JRST EXTSUB ; Substring SUB P,[1,,1] ; Exact match, reset stack TEST(NE,STEPF) TEST(NN,EXTSF) JRST EXTLKL EXTLK2: MOVE B,DIRSCN ; Get loc of pointer HRRZ B,(B) ; Location of fdb MOVEI B,DIRORG+FDBEXT(B); Location of pointer to next fdb MDDSTE: MOVEM B,DIRSCN MOVEM B,DIRLOC HRRZ A,(B) JUMPE A,[MOVEI A,GJFX19 JRST ERRET] ; None left MOVE C,FDBCTL+DIRORG(A) TLNE C,FDBNEX JRST [ MOVEI A,GJFX19 JRST ERRET] ; Non-existent HLRZ A,FDBEXT+DIRORG(A) ; Location of extension string ADDI A,DIRORG+1 MOVNI B,DIRORG ADDM B,DIRLOC HRLI A,() HLRZ B,FILEXW(JFN) ; Wild card string? JUMPE B,UNIQLC ; If not just carry on ADD B,[440700,,1] ; Yes, make it a string ptr PUSH P,A ; Save copy of extension string ptr EXCH A,B ; Set up input and library PUSHJ P,WCCMP ; Match ok? JRST [SUB P,[1,,1] ; No, clear this extension JRST EXTLK2] ; And try the next one POP P,A ; Good one, restore ptr JRST UNIQLC EXTLKL: MOVE B,DIRSCN ; Exact match. get loc of pointer HRRZ A,(B) ADDI A,DIRORG ; And loc of fdb MOVE C,FDBCTL(A) TLNE C,FDBTMP ; File already temp? TEST(O,TMPFF) ; Yes, set tmpff JRST NAMLKM ; Double skip return & unlock directory EXTSUB: TEST(NE,NREC,NREC1) JRST EXTNEQ test(on,mtchf) ; Already have match? jrst [move a,dirscn ; No, note this as the first movem a,dirloc jrst extneq] ; And try the next one hrrz a,@dirscn ; 1st match there, compare this one to it hlrz a,dirorg+fdbext(a) ; Adr of current string block hrrz b,dirloc ; Get str block for 1st one hrrz b,0(b) hlrz b,dirorg+fdbext(b) hlrz c,dirloc ; Count of prev matching chars pushj p,substr ; Get new substring count hrlm a,dirloc ; And save it EXTNEQ: HRRZ B,@DIRSCN ; Get loc of next fdb ADDI B,DIRORG+FDBEXT MOVEM B,DIRSCN HRRZ A,(B) ; Get loc of next fdb JUMPN A,[ADDI A,DIRORG JRST EXTLK1] POP P,B ; Recover next first DIRSCN TEST(NE,NREC,NREC1) JRST NEWEX1 ; Incomplete match, try new extension MOVEI A,GJFX19 TEST(NN,MTCHF) ; Any match at all? JRST ERRET ; No move b,dirloc ; Get rel adr of FDB for first hit hrr b,0(b) push p,b ; Save it for later movni c,dirorg ; OK, update string addm c,dirloc hlrz c,fdbext+dirorg(b) ; Get pointer to extension block pushj p,updstf ; Copy the tail to the input pop p,b ; Recover rel FDB adr hlrz c,dirloc ; Get # matching chars jumpn c,ambret ; If multiple hits, return ambiguous move c,fdbctl+dirorg(b) tlne c,fdbtmp ; If temp file test(o,tmpff) ; Set bit jrst namlk9 ; And return successfully NEWEX1: MOVEI A,GJFX24 TEST(NE,OLDNF) ; Are new files allowed? JRST ERRET MOVSI A,RNDF PUSHJ P,DIRCHK ; Append access ok? JRST [ MOVEI A,GJFX24 JRST ERRET] MOVEI B,FDBLEN PUSHJ P,ASGDFR ; Get space for new fdb JRST [ MOVEI A,GJFX23 JRST ERRET] PUSHJ P,FDBINI ; Initialize the fdb MOVE B,@DIRLOC ; Location of fdb with correct name HRRZ C,FDBCTL+DIRORG(B) HRRM C,FDBCTL(A) ; Move name pointer to new fdb MOVEM A,DIRSAV ; Save fdb location PUSHJ P,CPYDIR ; Copy extension string to directory JRST [ MOVE B,DIRSAV SETZM DIRSAV PUSHJ P,RELDFR MOVEI A,GJFX23 JRST ERRET] MOVEI C,400002 HRLM C,(A) ; Mark as string block for extension PUSH P,A MOVE A,DIRSAV SETZM DIRSAV MOVE C,DIRSCN ; Location of last extension pointer SUBI A,DIRORG ; Convert pointer to fdb to relative HRRZ B,(C) HRRM A,(C) ; Point last to this HRRM B,DIRORG+FDBEXT(A) ; Point this to next POP P,A JRST NEWEX2 NEWEXT: TEST(NN,NREC,NREC1) JRST [ MOVEI A,GJFX19 JRST ERRET] ; Recognition wanted TEST(NE,OLDNF) JRST [ MOVEI A,GJFX24 JRST ERRET] ; No new files PUSH P,A PUSHJ P,CPYDIR ; Copy string block into directory JRST [ POP P,A ; CLEAR STACK LEVEL MOVEI A,GJFX23 JRST ERRET] MOVEI C,400002 HRLM C,(A) ; Mark as string block for extension MOVSI B,FDBNEX POP P,C ANDCAM B,FDBCTL(C) ; No longer no extension NEWEX2: HRRZ B,@DIRSCN ADDI B,DIRORG SUBI A,DIRORG HRLM A,FDBEXT(B) ; Save in extension TEST(O,NEWF) ; Remember this is a new file MOVE B,DIRSCN HRRZ A,(B) ADDI A,DIRORG JRST NAMLKM ; Double skip return ; Multiple directory device version lookup routine ; Call: A ; Desired version ; DIRORG- ; The appropriate directory locked and psi off ; JRST MDDVER ; Return ; +1 ; Version not found ; +2 ; Success version in a if unlkf=1 ; ; Fdb address in a if unlkf=0 MDDVER::HRRES A ; Extend sign MOVEM A,DIRINP MOVEM B,DIRLOC HRRZ D,@B CAMN A,[-2] MOVEM D,DIRLOC HLRZ C,DIRORG+FDBVER(D) JUMPE C,VERLK7 ; This is first version of this file VERLK0: MOVEM B,DIRSCN ; Save scan pointer ADDI D,DIRORG ; Convert to absolute address MOVE C,FDBCTL(D) ; Get flag word VERLKA: TLNE C,FDBTMP ; If we ever see a temp version TEST(O,TMPFF) ; Consider this as temporary also JUMPG A,VERLK1 ; Specific version wanted CAMN A,[-2] JRST VERLKC CAMN A,[-1] ; New version wanted? JRST VERLK2 ; Yes JUMPL A,[MOVEI A,GJFX20 ; Can't have -3 here JRST ERRET] TLNE C,FDBDEL ; That leaves 0 - highest existing TEST(NE,IGDLF) TLNE C,FDBNXF ; Does this version exist yet? JRST VERLK1 ; Go to next one VERLK3: MOVE A,D ; Found VERLK8: TEST(NE,NEWVF,NEWF) JRST VERLKB TEST(NE,NEWNF) JRST [ MOVEI A,GJFX27 JRST ERRET] VERLKB: TEST(NE,STEPF) TEST(NN,VERSF) JRST VERLKE SKIPN DIRINP JRST VERLKE VERLKF: HRRZ B,FDBVER(A) ; Location of fdb of next version MOVEI A,GJFX20 JUMPE B,ERRET ; No more versions MOVEI A,DIRORG(B) MOVE B,FDBCTL(A) TEST(NN,IGDLF) TLNN B,FDBDEL ; If not ign del flg, check if deleted TLNE B,FDBNXF ; OK, check existence JRST VERLKF ; Can't use it, try next one TLNE B,FDBNEX JRST VERLKF VERLKE: TEST(NE,UNLKF) JRST SKPRET ; Return without unlocking directory HLRZ A,FDBVER(A) PUSHJ P,USTDIR JRST SKPRET VERLK7: SKIPG A MOVEI A,1 ; However it can be most recent+1 HRLM A,DIRORG+FDBVER(D) ; Or specific version MOVEI A,DIRORG(D) JRST VERLK8 VERLK2: TEST(O,NEWVF) TEST(Z,NEWF) TLNE C,FDBNXF ; Want next newer version TLNE C,FDBDEL ; If this version is deleted or JRST .+2 ; In existence, then create a new one JRST VERLK3 ; Otherwise, this one is the one VERLK6: MOVEI A,GJFX24 TEST(NE,OLDNF) JRST ERRET ; Old files only MOVSI A,RNDF PUSHJ P,DIRCHK ; Check for append access to directory JRST [ MOVEI A,GJFX24 JRST ERRET] MOVEI B,FDBLEN PUSHJ P,ASGDFR ; Assign space for a new fdb JRST [ MOVEI A,GJFX23 JRST ERRET] PUSHJ P,FDBINI ; Initialize the fdb HRRZ C,@DIRLOC ADDI C,DIRORG MOVE D,FDBCTL(C) ; Copy things from previous version TLZ D,FDBDEL!FDBLNG!FDBPRM!FDBUND TLO D,FDBNXF MOVEM D,FDBCTL(A) MOVE D,FDBEXT(C) MOVEM D,FDBEXT(A) MOVE D,FDBCRE(C) MOVEM D,FDBCRE(A) MOVE D,FDBPRT(C) MOVEM D,FDBPRT(A) SOSGE D,DIRINP ; Was specific version given? HLRZ D,FDBVER(C) ; No, get previous version number AOS D ; Increment HRLM D,FDBVER(A) ; And store in new fdb IFN 0,< LDB D,[POINT 6,FDBBYV(C),5] ;Get versions to keep DPB D,[POINT 6,FDBBYV(A),5] ;Copy to new version > SUBI A,DIRORG HRRZ B,@DIRSCN HRRM A,@DIRSCN ; Point predecessor to new fdb ADDI A,DIRORG HRRM B,FDBVER(A) MOVE B,DIRSCN TEST(O,NEWVF) ; Remember we created a new version JRST VERLK8 VERLKC: TLNE C,FDBDEL TEST(NE,IGDLF) TLNE C,FDBNXF JRST VERLK1 MOVEI C,-DIRORG(D) ; Get relative location MOVEM C,DIRLOC ; Save for later VERLK1: HLRZ C,FDBVER(D) ; Get version number of this fdb CAMG C,A ; Below desired version? JRST VERLK5 ; Yes, we have found where it belongs HRRZ B,@DIRSCN ; Step to next fdb ADDI B,FDBVER+DIRORG HRRZ D,@B JUMPN D,VERLK0 ; Continue search JUMPE A,[MOVEI A,GJFX20 JRST ERRET] ; Not found, can't create most recent CAMN A,[-2] JRST VERLKD HRRZ C,@DIRSCN ADDI C,DIRORG MOVEM B,DIRSCN JRST VERLK6 ; Insert new version here JRST VERLK0 ; And loop VERLKD: TEST(Z,NEWF,NEWVF) MOVEI A,GJFX20 MOVE D,DIRLOC MOVE C,FDBCTL+DIRORG(D) TLNE C,FDBDEL TEST(NE,IGDLF) TLNE C,FDBNXF JRST ERRET MOVEI A,DIRORG(D) JRST VERLK8 VERLK5: CAME C,A ; Exactly the right one? JRST VERLK6 ; Insert a new one MOVE B,DIRSCN HRRZ A,(B) ADDI A,DIRORG HLLZ C,FDBCTL(A) ; Get flags from fdb TEST(NE,STEPF) ; Are we stepping - here from GNJFN TEST(NN,VERSF) ; Yes, is it the version? SKIPA ; No stepping or else not vers - chk del JRST VERLKH ; Stepping version, allow deleted TLNE C,FDBDEL TEST(NE,OUTPF,IGDLF) JRST VERLKH MOVEI A,GJFX20 JRST ERRET VERLKH: TEST(NE,OUTPF) JRST [ TLZN C,FDBDEL ; File deleted? JRST .+1 ; No TLNE C,FDBPRM ; Permanent file? JRST [ SETZM FDBSIZ(A) ; Yes, just zero size JRST .+1] TLO C,FDBNXF ; Otherwise flag as non-existent JRST .+1] HLLM C,FDBCTL(A) TLNE C,FDBNXF ; Does the file exist? TEST(O,NEWVF) JRST VERLK8 ; Found ; Lookup of string in a directory ; Call: A ; Lookup pointer ; B ; Entry type ; PUSHJ P,LOOKUP ; Return ; +1 ; No exact match found ; +2 ; Exact match found LOOKUP: PUSH P,B ; Save entry type PUSHJ P,SETMSK ; Set up input pointer and mask MOVE A,SYMTOP SUB A,SYMBOT ; Get length of symbol table JFFO A,.+2 ; Get top 1 bit MOVEI A+1,^D35 MOVNS A+1 MOVSI A,400000 LSH A,(A+1) ; Largest power of 2 <= length MOVE B,SYMBOT SOS B ; Start just below symbol table MOVUP: JUMPE A,STRFND ; And move up ADD B,A ASH A,-1 ; Halve increment CAMGE B,SYMTOP ; Too big? JRST SYMCMP ; No, compare strings MOVDN: JUMPE A,STRFDD SUB B,A ASH A,-1 CAML B,SYMTOP JRST MOVDN CAMGE B,SYMBOT BUG(HLT,) SYMCMP: MOVEM A,DIRINC ; Save increment MOVEM B,DIRLOC ; And symtab loc MOVE A,(P) PUSHJ P,NAMCM1 JRST [ MOVE B,DIRLOC ; Ab MOVE A,DIRINC JRST MOVUP] JRST [ TEST(OE,MTCHF) ; A) jrst strfd2 ; Clean up after BUGCHK strfd1: hrrz a,0(p) ; Get string block of first candidate hlrz a,dirorg(a) hrrz b,dirloc ; And that of the current one hlrz b,dirorg(b) ; Get string block of current candidate hlrz c,0(p) ; Count of currently matching chars pushj p,substr ; Get new substring length hrlm a,0(p) ; Save it jrst strfd0 ; Do them all strfd2: pop p,dirloc ; Restore DIRLOC SUB P,[XWD 1,1] POPJ P, NAMCMM: MOVEI A,0 NAMCM1: HRRZ C,DIRORG(B) ; Get entry type ANDI C,700000 ; Extract entry type CAMGE C,A ; Less than that being sought? JRST SKPRET ; Yes. CAMLE C,A ; Greater than entry type being sought? POPJ P, HLRZ A,DIRORG(B) ; Get loc of string block for this entry MOVN B,DIRORG(A) ; Get length of string block CAIGE C,100000 JRST SYMCM1 AOS A ; For entries greater than 0, there AOS B ; Is a share count which must be ignored SYMCM1: HRLZI B,2(B) ; To lh of b HRRI B,DIRORG+1(A) ; Rh in absolute address MOVE A,DIRINP ; Set up pointer to input string MOVE C,DIRMSK ; Set up mask JRST STRCMP ; And continue with string compare ; Setup mask and input pointer for directory looks ; Call: A ; Lookup pointer ; PUSHJ P,SETMSK ; Return ; +1 ; In dirinp, a string compare pointer to input ; In dirmsk, a mask of ones for masking last word of input string ; Clobbers a,b,c,d SETMSK::HLRE D,A ; Get size of the string block SUBM A,D ; Get loc of last full word MOVSI B,774000 ; 7 bit mask left justified MOVNI C,1 ; Mask of bits to ignore SETMS0: TDNN B,1(D) ; Look for the terminating null JRST SETMS1 ; There it is, c has 1's for ignoration LSH B,-7 ; Not there, shift to next bit LSH C,-7 JRST SETMS0 SETMS1: SETCAM C,DIRMSK ; Get mask of bits to test in last word AOS A MOVEM A,DIRINP ; Save input pointer POPJ P, ; Routine to find the largest common substring between two inputs and less ; that or equal to some a priori limit ; Entry: A = rel adr of first string block ; B = rel adr of second string block ; C = Max substring size + 1 (0 = infinite) ; Call: PUSHJ P,SUBSTR ; Return: +1 always with number of common chars in A substr: push p,5 ; Save an extra AC jumpg c,[subi c,1 ; If pos count, remove +1 part jumpe c,subst2 ; If 0, quit jrst subst0] ; Otherwise, measure strings hrrz c,dirorg(a) ; Get minimum block length or inputs hrrz d,dirorg(b) caile c,0(d) movei c,0(d) subi c,1 ; Account for header imuli c,5 ; Max # chars that can match subst0: movns c ; Make AOBJN ptr hrlzs c move d,dirinp ; Construct ptrs just past end of input movni d,0(d) ; Negative of origin of input add d,filopt(jfn) ; Ptr to end of input relative to beginning addi d,dirorg+1 ; Abs ptr to tail of string + 1 add a,d ; Now make abs ptrs into strings add b,d subst1: ildb 4,a ; Input 1 char ildb 5,b ; Input 2 char caie 4,0(5) ; Equal? jrst subst2 ; No jumpe 4,subst2 ; Yes, but if null, still quit aobjn c,subst1 ; Count it and do the rest subst2: pop p,5 ; Recover AC movei a,1(c) ; Count of compares + 1 popj p, ; Copy the dirinp string to a new string block in directory ; Call: DIRINP ; The input pointer ; PUSHJ P,CPYDIR ; Return ; +1 ; No room ; +2 ; Ok, in a, the location of the string block ; Clobbers a,b,c,d CPYDIR:: HLRE A,DIRINP ; Get length of input MOVN B,A ; Make positive and account ADDI B,2 ; for header and partial word PUSH P,B ; Save for below PUSHJ P,ASGDFR ; Assign space for name string JRST [ POP P,B ; No room POPJ P,] HRLZ B,DIRINP ; Get loc of input string block HRRI B,1(A) ; And string block in directory POP P,D ; Length of block ADDI D,-2(B) ; Points to last word of new string BLT B,(D) ; Copy string into directory MOVE C,DIRMSK ; Get mask ANDM C,(D) ; Zero low part of last word of string AOS (P) POPJ P, ; Expand symbol table region of a directory ; Call: PUSHJ P,XPAND XPAND:: PUSHJ P,GCDIR ; First garbage collect directory PUSH P,A HLRZ A,DIRFRE ; Get location of the free block JUMPE A,XPAND1 ; No room PUSH P,B HRRZ B,DIRORG(A) ; Get size of the free block PUSH P,B ASH B,-3 ; Reserve 1/8 MOVNI B,1(B) ; +1 ADD B,0(P) ; For symtab MOVEM B,DIRFRE+2 HRRM B,DIRORG(A) SKIPN B ; If zero size, HRRZS DIRFRE ; Then no free blocks left POP P,A ; Get former block size MOVNI A,(A) ADD A,B ; Yields -delta ADDB A,FRETOP ; Modify top pointer HRLM A,DIRFRE+4 POP P,B POP P,A JRST SKPRET XPAND0::PUSH P,A XPAND1: MOVE A,SYMTOP ADDI A,1777 ANDCMI A,777 ; Move to page boundary SKIPG DIRNUM ; SUBINDEX? CAIG A,10000 ; YES, LIMIT SIZE TO 8 PAGES CAILE A,20000 ; NO. Absolute end of directory JRST XPAND2 ; Fail SUB A,SYMTOP ; Delta PUSH P,B ; Save b HRRZ B,DIRLOC ; Get dirloc CAIL B,DIRORG ; If relative pointer, leave it SUBI B,DIRORG ; Else convert to relative eqv CAML B,FRETOP ; If it does not point to dynamic area ADDM A,DIRLOC ; Adjust for symtab movement HRRZ B,DIRSCN ; Ditto for dirscn CAIL B,DIRORG SUBI B,DIRORG CAML B,FRETOP ADDM A,DIRSCN HRLI A,() MOVE B,SYMTOP SUB B,SYMBOT JUMPE B,XPAND5 ; Nothing in symtab HRLZS B ; Count in lh HRR B,SYMTOP ADDI B,DIRORG-1 XCT A ; Pop b,delta(b) TLNE B,777777 JRST .-2 XPAND5: HRRZS A ADDM A,SYMTOP ADDM A,SYMBOT POP P,B POP P,A JRST SKPRET XPAND2: POP P,A POPJ P, ; String compare routine ; Call: LH(A) ; Minus number of full words in string 1 ; RH(A) ; Loc of first word of string ; LH(B) ; Minus number of full words in string 2 ; RH(B) ; Loc of first word of string ; C ; A mask of 1's for last word of string1 ; PUSHJ P,STRCMP ; Return ; +1 ; A < b ; +2 ; A > b ; +3 ; A = initial subset of b ; +4 ; A = b ; Clobbers a,b,c,d STRCMP: PUSH P,C STRCM0: JUMPGE A,STRCM1 ; Down to last word of string a JCRY0 .+1 ; Cleap carry 0 MOVE D,(B) ; Get word of string b MOVE C,(A) ; And word of string a ANDCMI C,1 ; Get rid of superfluous bits 35 ANDCMI D,1 SUB D,C ; Compare the words JUMPE D,STRCM2 ; Equal, step to next word JCRY0 .+2 ; A < b STRCM3: AOS -1(P) ; A > b POP P,C POPJ P, STRCM2: JUMPGE B,STRCM3 ; Is b gone? AOBJN A,.+1 ; No, step to next word AOBJN B,STRCM0 JRST STRCM0 STRCM1: POP P,C MOVE D,(A) ; Get last word of string a AND D,C ; Get rid of garbage SKIPL B ; If string b is also down to last word, CAME D,(B) ; Check for exact match JRST STRCM4 ; Not exact match MOVEI D,3 ; Exact match ADDM D,(P) ; Triple skip POPJ P, STRCM4: AND C,(B) ; Truncate string b to same length as a JCRY0 .+1 ; Clear carry 0 SUB C,D ; Compare a to truncated b JUMPE C,SK2RET ; Equal, subset JCRY0 CPOPJ ; A < b JRST SKPRET ; A > b END